home *** CD-ROM | disk | FTP | other *** search
/ Mac-Source 1994 July / Mac-Source_July_1994.iso / Other Langs / Tickle-4.0 (tcl) / tcl / src / tclHash.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-10-25  |  25.1 KB  |  942 lines  |  [TEXT/MPS ]

  1. #ifdef MPW
  2. #    pragma segment TCL_HASH
  3. #endif
  4.  
  5. /* 
  6.  * tclHash.c --
  7.  *
  8.  *    Implementation of in-memory hash tables for Tcl and Tcl-based
  9.  *    applications.
  10.  *
  11.  * Copyright (c) 1991-1993 The Regents of the University of California.
  12.  * All rights reserved.
  13.  *
  14.  * Permission is hereby granted, without written agreement and without
  15.  * license or royalty fees, to use, copy, modify, and distribute this
  16.  * software and its documentation for any purpose, provided that the
  17.  * above copyright notice and the following two paragraphs appear in
  18.  * all copies of this software.
  19.  * 
  20.  * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
  21.  * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
  22.  * OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
  23.  * CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  24.  *
  25.  * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
  26.  * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
  27.  * AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
  28.  * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
  29.  * PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
  30.  */
  31.  
  32. #ifndef lint
  33. static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclHash.c,v 1.13 93/06/02 10:17:13 ouster Exp $ SPRITE (Berkeley)";
  34. #endif /* not lint */
  35.  
  36. #include "tclInt.h"
  37.  
  38. /*
  39.  * When there are this many entries per bucket, on average, rebuild
  40.  * the hash table to make it larger.
  41.  */
  42.  
  43. #define REBUILD_MULTIPLIER    3
  44.  
  45.  
  46. /*
  47.  * The following macro takes a preliminary integer hash value and
  48.  * produces an index into a hash tables bucket list.  The idea is
  49.  * to make it so that preliminary values that are arbitrarily similar
  50.  * will end up in different buckets.  The hash function was taken
  51.  * from a random-number generator.
  52.  */
  53.  
  54. #define RANDOM_INDEX(tablePtr, i) \
  55.     (((((long) (i))*1103515245) >> (tablePtr)->downShift) & (tablePtr)->mask)
  56.  
  57. /*
  58.  * Procedure prototypes for static procedures in this file:
  59.  */
  60.  
  61. static Tcl_HashEntry *    ArrayFind _ANSI_ARGS_((Tcl_HashTable *tablePtr,
  62.                 char *key));
  63. static Tcl_HashEntry *    ArrayCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr,
  64.                 char *key, int *newPtr));
  65. static Tcl_HashEntry *    BogusFind _ANSI_ARGS_((Tcl_HashTable *tablePtr,
  66.                 char *key));
  67. static Tcl_HashEntry *    BogusCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr,
  68.                 char *key, int *newPtr));
  69. static unsigned int    HashString _ANSI_ARGS_((char *string));
  70. static void        RebuildTable _ANSI_ARGS_((Tcl_HashTable *tablePtr));
  71. static Tcl_HashEntry *    StringFind _ANSI_ARGS_((Tcl_HashTable *tablePtr,
  72.                 char *key));
  73. static Tcl_HashEntry *    StringCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr,
  74.                 char *key, int *newPtr));
  75. static Tcl_HashEntry *    OneWordFind _ANSI_ARGS_((Tcl_HashTable *tablePtr,
  76.                 char *key));
  77. static Tcl_HashEntry *    OneWordCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr,
  78.                 char *key, int *newPtr));
  79.  
  80. /*
  81.  *----------------------------------------------------------------------
  82.  *
  83.  * Tcl_InitHashTable --
  84.  *
  85.  *    Given storage for a hash table, set up the fields to prepare
  86.  *    the hash table for use.
  87.  *
  88.  * Results:
  89.  *    None.
  90.  *
  91.  * Side effects:
  92.  *    TablePtr is now ready to be passed to Tcl_FindHashEntry and
  93.  *    Tcl_CreateHashEntry.
  94.  *
  95.  *----------------------------------------------------------------------
  96.  */
  97.  
  98. void
  99. Tcl_InitHashTable(tablePtr, keyType)
  100.     register Tcl_HashTable *tablePtr;    /* Pointer to table record, which
  101.                      * is supplied by the caller. */
  102.     int keyType;            /* Type of keys to use in table:
  103.                      * TCL_STRING_KEYS, TCL_ONE_WORD_KEYS,
  104.                      * or an integer >= 2. */
  105. {
  106.     tablePtr->buckets = tablePtr->staticBuckets;
  107.     tablePtr->staticBuckets[0] = tablePtr->staticBuckets[1] = 0;
  108.     tablePtr->staticBuckets[2] = tablePtr->staticBuckets[3] = 0;
  109.     tablePtr->numBuckets = TCL_SMALL_HASH_TABLE;
  110.     tablePtr->numEntries = 0;
  111.     tablePtr->rebuildSize = TCL_SMALL_HASH_TABLE*REBUILD_MULTIPLIER;
  112.     tablePtr->downShift = 28;
  113.     tablePtr->mask = 3;
  114.     tablePtr->keyType = keyType;
  115.     if (keyType == TCL_STRING_KEYS) {
  116.     tablePtr->findProc = StringFind;
  117.     tablePtr->createProc = StringCreate;
  118.     } else if (keyType == TCL_ONE_WORD_KEYS) {
  119.     tablePtr->findProc = OneWordFind;
  120.     tablePtr->createProc = OneWordCreate;
  121.     } else {
  122.     tablePtr->findProc = ArrayFind;
  123.     tablePtr->createProc = ArrayCreate;
  124.     };
  125. }
  126.  
  127. /*
  128.  *----------------------------------------------------------------------
  129.  *
  130.  * Tcl_DeleteHashEntry --
  131.  *
  132.  *    Remove a single entry from a hash table.
  133.  *
  134.  * Results:
  135.  *    None.
  136.  *
  137.  * Side effects:
  138.  *    The entry given by entryPtr is deleted from its table and
  139.  *    should never again be used by the caller.  It is up to the
  140.  *    caller to free the clientData field of the entry, if that
  141.  *    is relevant.
  142.  *
  143.  *----------------------------------------------------------------------
  144.  */
  145.  
  146. void
  147. Tcl_DeleteHashEntry(entryPtr)
  148.     Tcl_HashEntry *entryPtr;
  149. {
  150.     register Tcl_HashEntry *prevPtr;
  151.  
  152.     if (*entryPtr->bucketPtr == entryPtr) {
  153.     *entryPtr->bucketPtr = entryPtr->nextPtr;
  154.     } else {
  155.     for (prevPtr = *entryPtr->bucketPtr; ; prevPtr = prevPtr->nextPtr) {
  156.         if (prevPtr == NULL) {
  157.         panic("malformed bucket chain in Tcl_DeleteHashEntry");
  158.         }
  159.         if (prevPtr->nextPtr == entryPtr) {
  160.         prevPtr->nextPtr = entryPtr->nextPtr;
  161.         break;
  162.         }
  163.     }
  164.     }
  165.     entryPtr->tablePtr->numEntries--;
  166.     ckfree((char *) entryPtr);
  167. }
  168.  
  169. /*
  170.  *----------------------------------------------------------------------
  171.  *
  172.  * Tcl_DeleteHashTable --
  173.  *
  174.  *    Free up everything associated with a hash table except for
  175.  *    the record for the table itself.
  176.  *
  177.  * Results:
  178.  *    None.
  179.  *
  180.  * Side effects:
  181.  *    The hash table is no longer useable.
  182.  *
  183.  *----------------------------------------------------------------------
  184.  */
  185.  
  186. void
  187. Tcl_DeleteHashTable(tablePtr)
  188.     register Tcl_HashTable *tablePtr;        /* Table to delete. */
  189. {
  190.     register Tcl_HashEntry *hPtr, *nextPtr;
  191.     int i;
  192.  
  193.     /*
  194.      * Free up all the entries in the table.
  195.      */
  196.  
  197.     for (i = 0; i < tablePtr->numBuckets; i++) {
  198.     hPtr = tablePtr->buckets[i];
  199.     while (hPtr != NULL) {
  200.         nextPtr = hPtr->nextPtr;
  201.         ckfree((char *) hPtr);
  202.         hPtr = nextPtr;
  203.     }
  204.     }
  205.  
  206.     /*
  207.      * Free up the bucket array, if it was dynamically allocated.
  208.      */
  209.  
  210.     if (tablePtr->buckets != tablePtr->staticBuckets) {
  211.     ckfree((char *) tablePtr->buckets);
  212.     }
  213.  
  214.     /*
  215.      * Arrange for panics if the table is used again without
  216.      * re-initialization.
  217.      */
  218.  
  219.     tablePtr->findProc = BogusFind;
  220.     tablePtr->createProc = BogusCreate;
  221. }
  222.  
  223. /*
  224.  *----------------------------------------------------------------------
  225.  *
  226.  * Tcl_FirstHashEntry --
  227.  *
  228.  *    Locate the first entry in a hash table and set up a record
  229.  *    that can be used to step through all the remaining entries
  230.  *    of the table.
  231.  *
  232.  * Results:
  233.  *    The return value is a pointer to the first entry in tablePtr,
  234.  *    or NULL if tablePtr has no entries in it.  The memory at
  235.  *    *searchPtr is initialized so that subsequent calls to
  236.  *    Tcl_NextHashEntry will return all of the entries in the table,
  237.  *    one at a time.
  238.  *
  239.  * Side effects:
  240.  *    None.
  241.  *
  242.  *----------------------------------------------------------------------
  243.  */
  244.  
  245. Tcl_HashEntry *
  246. Tcl_FirstHashEntry(tablePtr, searchPtr)
  247.     Tcl_HashTable *tablePtr;        /* Table to search. */
  248.     Tcl_HashSearch *searchPtr;        /* Place to store information about
  249.                      * progress through the table. */
  250. {
  251.     searchPtr->tablePtr = tablePtr;
  252.     searchPtr->nextIndex = 0;
  253.     searchPtr->nextEntryPtr = NULL;
  254.     return Tcl_NextHashEntry(searchPtr);
  255. }
  256.  
  257. /*
  258.  *----------------------------------------------------------------------
  259.  *
  260.  * Tcl_NextHashEntry --
  261.  *
  262.  *    Once a hash table enumeration has been initiated by calling
  263.  *    Tcl_FirstHashEntry, this procedure may be called to return
  264.  *    successive elements of the table.
  265.  *
  266.  * Results:
  267.  *    The return value is the next entry in the hash table being
  268.  *    enumerated, or NULL if the end of the table is reached.
  269.  *
  270.  * Side effects:
  271.  *    None.
  272.  *
  273.  *----------------------------------------------------------------------
  274.  */
  275.  
  276. Tcl_HashEntry *
  277. Tcl_NextHashEntry(searchPtr)
  278.     register Tcl_HashSearch *searchPtr;    /* Place to store information about
  279.                      * progress through the table.  Must
  280.                      * have been initialized by calling
  281.                      * Tcl_FirstHashEntry. */
  282. {
  283.     Tcl_HashEntry *hPtr;
  284.  
  285.     while (searchPtr->nextEntryPtr == NULL) {
  286.     if (searchPtr->nextIndex >= searchPtr->tablePtr->numBuckets) {
  287.         return NULL;
  288.     }
  289.     searchPtr->nextEntryPtr =
  290.         searchPtr->tablePtr->buckets[searchPtr->nextIndex];
  291.     searchPtr->nextIndex++;
  292.     }
  293.     hPtr = searchPtr->nextEntryPtr;
  294.     searchPtr->nextEntryPtr = hPtr->nextPtr;
  295.     return hPtr;
  296. }
  297.  
  298. /*
  299.  *----------------------------------------------------------------------
  300.  *
  301.  * Tcl_HashStats --
  302.  *
  303.  *    Return statistics describing the layout of the hash table
  304.  *    in its hash buckets.
  305.  *
  306.  * Results:
  307.  *    The return value is a malloc-ed string containing information
  308.  *    about tablePtr.  It is the caller's responsibility to free
  309.  *    this string.
  310.  *
  311.  * Side effects:
  312.  *    None.
  313.  *
  314.  *----------------------------------------------------------------------
  315.  */
  316.  
  317. char *
  318. Tcl_HashStats(tablePtr)
  319.     Tcl_HashTable *tablePtr;        /* Table for which to produce stats. */
  320. {
  321. #define NUM_COUNTERS 10
  322.     int count[NUM_COUNTERS], overflow, i, j;
  323.     double average, tmp;
  324.     register Tcl_HashEntry *hPtr;
  325.     char *result, *p;
  326.  
  327.     /*
  328.      * Compute a histogram of bucket usage.
  329.      */
  330.  
  331.     for (i = 0; i < NUM_COUNTERS; i++) {
  332.     count[i] = 0;
  333.     }
  334.     overflow = 0;
  335.     average = 0.0;
  336.     for (i = 0; i < tablePtr->numBuckets; i++) {
  337.     j = 0;
  338.     for (hPtr = tablePtr->buckets[i]; hPtr != NULL; hPtr = hPtr->nextPtr) {
  339.         j++;
  340.     }
  341.     if (j < NUM_COUNTERS) {
  342.         count[j]++;
  343.     } else {
  344.         overflow++;
  345.     }
  346.     tmp = j;
  347.     average += (tmp+1.0)*(tmp/tablePtr->numEntries)/2.0;
  348.     }
  349.  
  350.     /*
  351.      * Print out the histogram and a few other pieces of information.
  352.      */
  353.  
  354.     result = (char *) ckalloc((unsigned) ((NUM_COUNTERS*60) + 300));
  355.     sprintf(result, "%d entries in table, %d buckets\n",
  356.         tablePtr->numEntries, tablePtr->numBuckets);
  357.     p = result + strlen(result);
  358.     for (i = 0; i < NUM_COUNTERS; i++) {
  359.     sprintf(p, "number of buckets with %d entries: %d\n",
  360.         i, count[i]);
  361.     p += strlen(p);
  362.     }
  363.     sprintf(p, "number of buckets with %d or more entries: %d\n",
  364.         NUM_COUNTERS, overflow);
  365.     p += strlen(p);
  366.     sprintf(p, "average search distance for entry: %.1f", average);
  367.     return result;
  368. }
  369.  
  370. /*
  371.  *----------------------------------------------------------------------
  372.  *
  373.  * HashString --
  374.  *
  375.  *    Compute a one-word summary of a text string, which can be
  376.  *    used to generate a hash index.
  377.  *
  378.  * Results:
  379.  *    The return value is a one-word summary of the information in
  380.  *    string.
  381.  *
  382.  * Side effects:
  383.  *    None.
  384.  *
  385.  *----------------------------------------------------------------------
  386.  */
  387.  
  388. static unsigned int
  389. HashString(string)
  390.     register char *string;    /* String from which to compute hash value. */
  391. {
  392.     register unsigned int result;
  393.     register int c;
  394.  
  395.     /*
  396.      * I tried a zillion different hash functions and asked many other
  397.      * people for advice.  Many people had their own favorite functions,
  398.      * all different, but no-one had much idea why they were good ones.
  399.      * I chose the one below (multiply by 9 and add new character)
  400.      * because of the following reasons:
  401.      *
  402.      * 1. Multiplying by 10 is perfect for keys that are decimal strings,
  403.      *    and multiplying by 9 is just about as good.
  404.      * 2. Times-9 is (shift-left-3) plus (old).  This means that each
  405.      *    character's bits hang around in the low-order bits of the
  406.      *    hash value for ever, plus they spread fairly rapidly up to
  407.      *    the high-order bits to fill out the hash value.  This seems
  408.      *    works well both for decimal and non-decimal strings.
  409.      */
  410.  
  411.     result = 0;
  412.     while (1) {
  413.     c = *string;
  414.     string++;
  415.     if (c == 0) {
  416.         break;
  417.     }
  418.     result += (result<<3) + c;
  419.     }
  420.     return result;
  421. }
  422.  
  423. /*
  424.  *----------------------------------------------------------------------
  425.  *
  426.  * StringFind --
  427.  *
  428.  *    Given a hash table with string keys, and a string key, find
  429.  *    the entry with a matching key.
  430.  *
  431.  * Results:
  432.  *    The return value is a token for the matching entry in the
  433.  *    hash table, or NULL if there was no matching entry.
  434.  *
  435.  * Side effects:
  436.  *    None.
  437.  *
  438.  *----------------------------------------------------------------------
  439.  */
  440.  
  441. static Tcl_HashEntry *
  442. StringFind(tablePtr, key)
  443.     Tcl_HashTable *tablePtr;    /* Table in which to lookup entry. */
  444.     char *key;            /* Key to use to find matching entry. */
  445. {
  446.     register Tcl_HashEntry *hPtr;
  447.     register char *p1, *p2;
  448.     int index;
  449.  
  450.     index = HashString(key) & tablePtr->mask;
  451.  
  452.     /*
  453.      * Search all of the entries in the appropriate bucket.
  454.      */
  455.  
  456.     for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
  457.         hPtr = hPtr->nextPtr) {
  458.     for (p1 = key, p2 = hPtr->key.string; ; p1++, p2++) {
  459.         if (*p1 != *p2) {
  460.         break;
  461.         }
  462.         if (*p1 == '\0') {
  463.         return hPtr;
  464.         }
  465.     }
  466.     }
  467.     return NULL;
  468. }
  469.  
  470. /*
  471.  *----------------------------------------------------------------------
  472.  *
  473.  * StringCreate --
  474.  *
  475.  *    Given a hash table with string keys, and a string key, find
  476.  *    the entry with a matching key.  If there is no matching entry,
  477.  *    then create a new entry that does match.
  478.  *
  479.  * Results:
  480.  *    The return value is a pointer to the matching entry.  If this
  481.  *    is a newly-created entry, then *newPtr will be set to a non-zero
  482.  *    value;  otherwise *newPtr will be set to 0.  If this is a new
  483.  *    entry the value stored in the entry will initially be 0.
  484.  *
  485.  * Side effects:
  486.  *    A new entry may be added to the hash table.
  487.  *
  488.  *----------------------------------------------------------------------
  489.  */
  490.  
  491. static Tcl_HashEntry *
  492. StringCreate(tablePtr, key, newPtr)
  493.     Tcl_HashTable *tablePtr;    /* Table in which to lookup entry. */
  494.     char *key;            /* Key to use to find or create matching
  495.                  * entry. */
  496.     int *newPtr;        /* Store info here telling whether a new
  497.                  * entry was created. */
  498. {
  499.     register Tcl_HashEntry *hPtr;
  500.     register char *p1, *p2;
  501.     int index;
  502.  
  503.     index = HashString(key) & tablePtr->mask;
  504.  
  505.     /*
  506.      * Search all of the entries in this bucket.
  507.      */
  508.  
  509.     for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
  510.         hPtr = hPtr->nextPtr) {
  511.     for (p1 = key, p2 = hPtr->key.string; ; p1++, p2++) {
  512.         if (*p1 != *p2) {
  513.         break;
  514.         }
  515.         if (*p1 == '\0') {
  516.         *newPtr = 0;
  517.         return hPtr;
  518.         }
  519.     }
  520.     }
  521.  
  522.     /*
  523.      * Entry not found.  Add a new one to the bucket.
  524.      */
  525.  
  526.     *newPtr = 1;
  527.     hPtr = (Tcl_HashEntry *) ckalloc((unsigned)
  528.         (sizeof(Tcl_HashEntry) + strlen(key) - (sizeof(hPtr->key) -1)));
  529.     hPtr->tablePtr = tablePtr;
  530.     hPtr->bucketPtr = &(tablePtr->buckets[index]);
  531.     hPtr->nextPtr = *hPtr->bucketPtr;
  532.     hPtr->clientData = 0;
  533.     strcpy(hPtr->key.string, key);
  534.     *hPtr->bucketPtr = hPtr;
  535.     tablePtr->numEntries++;
  536.  
  537.     /*
  538.      * If the table has exceeded a decent size, rebuild it with many
  539.      * more buckets.
  540.      */
  541.  
  542.     if (tablePtr->numEntries >= tablePtr->rebuildSize) {
  543.     RebuildTable(tablePtr);
  544.     }
  545.     return hPtr;
  546. }
  547.  
  548. /*
  549.  *----------------------------------------------------------------------
  550.  *
  551.  * OneWordFind --
  552.  *
  553.  *    Given a hash table with one-word keys, and a one-word key, find
  554.  *    the entry with a matching key.
  555.  *
  556.  * Results:
  557.  *    The return value is a token for the matching entry in the
  558.  *    hash table, or NULL if there was no matching entry.
  559.  *
  560.  * Side effects:
  561.  *    None.
  562.  *
  563.  *----------------------------------------------------------------------
  564.  */
  565.  
  566. static Tcl_HashEntry *
  567. OneWordFind(tablePtr, key)
  568.     Tcl_HashTable *tablePtr;    /* Table in which to lookup entry. */
  569.     register char *key;        /* Key to use to find matching entry. */
  570. {
  571.     register Tcl_HashEntry *hPtr;
  572.     int index;
  573.  
  574.     index = RANDOM_INDEX(tablePtr, key);
  575.  
  576.     /*
  577.      * Search all of the entries in the appropriate bucket.
  578.      */
  579.  
  580.     for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
  581.         hPtr = hPtr->nextPtr) {
  582.     if (hPtr->key.oneWordValue == key) {
  583.         return hPtr;
  584.     }
  585.     }
  586.     return NULL;
  587. }
  588.  
  589. /*
  590.  *----------------------------------------------------------------------
  591.  *
  592.  * OneWordCreate --
  593.  *
  594.  *    Given a hash table with one-word keys, and a one-word key, find
  595.  *    the entry with a matching key.  If there is no matching entry,
  596.  *    then create a new entry that does match.
  597.  *
  598.  * Results:
  599.  *    The return value is a pointer to the matching entry.  If this
  600.  *    is a newly-created entry, then *newPtr will be set to a non-zero
  601.  *    value;  otherwise *newPtr will be set to 0.  If this is a new
  602.  *    entry the value stored in the entry will initially be 0.
  603.  *
  604.  * Side effects:
  605.  *    A new entry may be added to the hash table.
  606.  *
  607.  *----------------------------------------------------------------------
  608.  */
  609.  
  610. static Tcl_HashEntry *
  611. OneWordCreate(tablePtr, key, newPtr)
  612.     Tcl_HashTable *tablePtr;    /* Table in which to lookup entry. */
  613.     register char *key;        /* Key to use to find or create matching
  614.                  * entry. */
  615.     int *newPtr;        /* Store info here telling whether a new
  616.                  * entry was created. */
  617. {
  618.     register Tcl_HashEntry *hPtr;
  619.     int index;
  620.  
  621.     index = RANDOM_INDEX(tablePtr, key);
  622.  
  623.     /*
  624.      * Search all of the entries in this bucket.
  625.      */
  626.  
  627.     for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
  628.         hPtr = hPtr->nextPtr) {
  629.     if (hPtr->key.oneWordValue == key) {
  630.         *newPtr = 0;
  631.         return hPtr;
  632.     }
  633.     }
  634.  
  635.     /*
  636.      * Entry not found.  Add a new one to the bucket.
  637.      */
  638.  
  639.     *newPtr = 1;
  640.     hPtr = (Tcl_HashEntry *) ckalloc(sizeof(Tcl_HashEntry));
  641.     hPtr->tablePtr = tablePtr;
  642.     hPtr->bucketPtr = &(tablePtr->buckets[index]);
  643.     hPtr->nextPtr = *hPtr->bucketPtr;
  644.     hPtr->clientData = 0;
  645.     hPtr->key.oneWordValue = key;
  646.     *hPtr->bucketPtr = hPtr;
  647.     tablePtr->numEntries++;
  648.  
  649.     /*
  650.      * If the table has exceeded a decent size, rebuild it with many
  651.      * more buckets.
  652.      */
  653.  
  654.     if (tablePtr->numEntries >= tablePtr->rebuildSize) {
  655.     RebuildTable(tablePtr);
  656.     }
  657.     return hPtr;
  658. }
  659.  
  660. /*
  661.  *----------------------------------------------------------------------
  662.  *
  663.  * ArrayFind --
  664.  *
  665.  *    Given a hash table with array-of-int keys, and a key, find
  666.  *    the entry with a matching key.
  667.  *
  668.  * Results:
  669.  *    The return value is a token for the matching entry in the
  670.  *    hash table, or NULL if there was no matching entry.
  671.  *
  672.  * Side effects:
  673.  *    None.
  674.  *
  675.  *----------------------------------------------------------------------
  676.  */
  677.  
  678. static Tcl_HashEntry *
  679. ArrayFind(tablePtr, key)
  680.     Tcl_HashTable *tablePtr;    /* Table in which to lookup entry. */
  681.     char *key;            /* Key to use to find matching entry. */
  682. {
  683.     register Tcl_HashEntry *hPtr;
  684.     int *arrayPtr = (int *) key;
  685.     register int *iPtr1, *iPtr2;
  686.     int index, count;
  687.  
  688.     for (index = 0, count = tablePtr->keyType, iPtr1 = arrayPtr;
  689.         count > 0; count--, iPtr1++) {
  690.     index += *iPtr1;
  691.     }
  692.     index = RANDOM_INDEX(tablePtr, index);
  693.  
  694.     /*
  695.      * Search all of the entries in the appropriate bucket.
  696.      */
  697.  
  698.     for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
  699.         hPtr = hPtr->nextPtr) {
  700.     for (iPtr1 = arrayPtr, iPtr2 = hPtr->key.words,
  701.         count = tablePtr->keyType; ; count--, iPtr1++, iPtr2++) {
  702.         if (count == 0) {
  703.         return hPtr;
  704.         }
  705.         if (*iPtr1 != *iPtr2) {
  706.         break;
  707.         }
  708.     }
  709.     }
  710.     return NULL;
  711. }
  712.  
  713. /*
  714.  *----------------------------------------------------------------------
  715.  *
  716.  * ArrayCreate --
  717.  *
  718.  *    Given a hash table with one-word keys, and a one-word key, find
  719.  *    the entry with a matching key.  If there is no matching entry,
  720.  *    then create a new entry that does match.
  721.  *
  722.  * Results:
  723.  *    The return value is a pointer to the matching entry.  If this
  724.  *    is a newly-created entry, then *newPtr will be set to a non-zero
  725.  *    value;  otherwise *newPtr will be set to 0.  If this is a new
  726.  *    entry the value stored in the entry will initially be 0.
  727.  *
  728.  * Side effects:
  729.  *    A new entry may be added to the hash table.
  730.  *
  731.  *----------------------------------------------------------------------
  732.  */
  733.  
  734. static Tcl_HashEntry *
  735. ArrayCreate(tablePtr, key, newPtr)
  736.     Tcl_HashTable *tablePtr;    /* Table in which to lookup entry. */
  737.     register char *key;        /* Key to use to find or create matching
  738.                  * entry. */
  739.     int *newPtr;        /* Store info here telling whether a new
  740.                  * entry was created. */
  741. {
  742.     register Tcl_HashEntry *hPtr;
  743.     int *arrayPtr = (int *) key;
  744.     register int *iPtr1, *iPtr2;
  745.     int index, count;
  746.  
  747.     for (index = 0, count = tablePtr->keyType, iPtr1 = arrayPtr;
  748.         count > 0; count--, iPtr1++) {
  749.     index += *iPtr1;
  750.     }
  751.     index = RANDOM_INDEX(tablePtr, index);
  752.  
  753.     /*
  754.      * Search all of the entries in the appropriate bucket.
  755.      */
  756.  
  757.     for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
  758.         hPtr = hPtr->nextPtr) {
  759.     for (iPtr1 = arrayPtr, iPtr2 = hPtr->key.words,
  760.         count = tablePtr->keyType; ; count--, iPtr1++, iPtr2++) {
  761.         if (count == 0) {
  762.         *newPtr = 0;
  763.         return hPtr;
  764.         }
  765.         if (*iPtr1 != *iPtr2) {
  766.         break;
  767.         }
  768.     }
  769.     }
  770.  
  771.     /*
  772.      * Entry not found.  Add a new one to the bucket.
  773.      */
  774.  
  775.     *newPtr = 1;
  776.     hPtr = (Tcl_HashEntry *) ckalloc((unsigned) (sizeof(Tcl_HashEntry)
  777.         + (tablePtr->keyType*sizeof(int)) - 4));
  778.     hPtr->tablePtr = tablePtr;
  779.     hPtr->bucketPtr = &(tablePtr->buckets[index]);
  780.     hPtr->nextPtr = *hPtr->bucketPtr;
  781.     hPtr->clientData = 0;
  782.     for (iPtr1 = arrayPtr, iPtr2 = hPtr->key.words, count = tablePtr->keyType;
  783.         count > 0; count--, iPtr1++, iPtr2++) {
  784.     *iPtr2 = *iPtr1;
  785.     }
  786.     *hPtr->bucketPtr = hPtr;
  787.     tablePtr->numEntries++;
  788.  
  789.     /*
  790.      * If the table has exceeded a decent size, rebuild it with many
  791.      * more buckets.
  792.      */
  793.  
  794.     if (tablePtr->numEntries >= tablePtr->rebuildSize) {
  795.     RebuildTable(tablePtr);
  796.     }
  797.     return hPtr;
  798. }
  799.  
  800. /*
  801.  *----------------------------------------------------------------------
  802.  *
  803.  * BogusFind --
  804.  *
  805.  *    This procedure is invoked when an Tcl_FindHashEntry is called
  806.  *    on a table that has been deleted.
  807.  *
  808.  * Results:
  809.  *    If panic returns (which it shouldn't) this procedure returns
  810.  *    NULL.
  811.  *
  812.  * Side effects:
  813.  *    Generates a panic.
  814.  *
  815.  *----------------------------------------------------------------------
  816.  */
  817.  
  818.     /* ARGSUSED */
  819. static Tcl_HashEntry *
  820. BogusFind(tablePtr, key)
  821.     Tcl_HashTable *tablePtr;    /* Table in which to lookup entry. */
  822.     char *key;            /* Key to use to find matching entry. */
  823. {
  824.     panic("called Tcl_FindHashEntry on deleted table");
  825.     return NULL;
  826. }
  827.  
  828. /*
  829.  *----------------------------------------------------------------------
  830.  *
  831.  * BogusCreate --
  832.  *
  833.  *    This procedure is invoked when an Tcl_CreateHashEntry is called
  834.  *    on a table that has been deleted.
  835.  *
  836.  * Results:
  837.  *    If panic returns (which it shouldn't) this procedure returns
  838.  *    NULL.
  839.  *
  840.  * Side effects:
  841.  *    Generates a panic.
  842.  *
  843.  *----------------------------------------------------------------------
  844.  */
  845.  
  846.     /* ARGSUSED */
  847. static Tcl_HashEntry *
  848. BogusCreate(tablePtr, key, newPtr)
  849.     Tcl_HashTable *tablePtr;    /* Table in which to lookup entry. */
  850.     char *key;            /* Key to use to find or create matching
  851.                  * entry. */
  852.     int *newPtr;        /* Store info here telling whether a new
  853.                  * entry was created. */
  854. {
  855.     panic("called Tcl_CreateHashEntry on deleted table");
  856.     return NULL;
  857. }
  858.  
  859. /*
  860.  *----------------------------------------------------------------------
  861.  *
  862.  * RebuildTable --
  863.  *
  864.  *    This procedure is invoked when the ratio of entries to hash
  865.  *    buckets becomes too large.  It creates a new table with a
  866.  *    larger bucket array and moves all of the entries into the
  867.  *    new table.
  868.  *
  869.  * Results:
  870.  *    None.
  871.  *
  872.  * Side effects:
  873.  *    Memory gets reallocated and entries get re-hashed to new
  874.  *    buckets.
  875.  *
  876.  *----------------------------------------------------------------------
  877.  */
  878.  
  879. static void
  880. RebuildTable(tablePtr)
  881.     register Tcl_HashTable *tablePtr;    /* Table to enlarge. */
  882. {
  883.     int oldSize, count, index;
  884.     Tcl_HashEntry **oldBuckets;
  885.     register Tcl_HashEntry **oldChainPtr, **newChainPtr;
  886.     register Tcl_HashEntry *hPtr;
  887.  
  888.     oldSize = tablePtr->numBuckets;
  889.     oldBuckets = tablePtr->buckets;
  890.  
  891.     /*
  892.      * Allocate and initialize the new bucket array, and set up
  893.      * hashing constants for new array size.
  894.      */
  895.  
  896.     tablePtr->numBuckets *= 4;
  897.     tablePtr->buckets = (Tcl_HashEntry **) ckalloc((unsigned)
  898.         (tablePtr->numBuckets * sizeof(Tcl_HashEntry *)));
  899.     for (count = tablePtr->numBuckets, newChainPtr = tablePtr->buckets;
  900.         count > 0; count--, newChainPtr++) {
  901.     *newChainPtr = NULL;
  902.     }
  903.     tablePtr->rebuildSize *= 4;
  904.     tablePtr->downShift -= 2;
  905.     tablePtr->mask = (tablePtr->mask << 2) + 3;
  906.  
  907.     /*
  908.      * Rehash all of the existing entries into the new bucket array.
  909.      */
  910.  
  911.     for (oldChainPtr = oldBuckets; oldSize > 0; oldSize--, oldChainPtr++) {
  912.     for (hPtr = *oldChainPtr; hPtr != NULL; hPtr = *oldChainPtr) {
  913.         *oldChainPtr = hPtr->nextPtr;
  914.         if (tablePtr->keyType == TCL_STRING_KEYS) {
  915.         index = HashString(hPtr->key.string) & tablePtr->mask;
  916.         } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
  917.         index = RANDOM_INDEX(tablePtr, hPtr->key.oneWordValue);
  918.         } else {
  919.         register int *iPtr;
  920.         int count;
  921.  
  922.         for (index = 0, count = tablePtr->keyType,
  923.             iPtr = hPtr->key.words; count > 0; count--, iPtr++) {
  924.             index += *iPtr;
  925.         }
  926.         index = RANDOM_INDEX(tablePtr, index);
  927.         }
  928.         hPtr->bucketPtr = &(tablePtr->buckets[index]);
  929.         hPtr->nextPtr = *hPtr->bucketPtr;
  930.         *hPtr->bucketPtr = hPtr;
  931.     }
  932.     }
  933.  
  934.     /*
  935.      * Free up the old bucket array, if it was dynamically allocated.
  936.      */
  937.  
  938.     if (oldBuckets != tablePtr->staticBuckets) {
  939.     ckfree((char *) oldBuckets);
  940.     }
  941. }
  942.